Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/graphics/peacoc/samplvbx.frm

Text File | 1994-10-27 | 11KB | 465 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Color By Name"
   ClientHeight    =   4860
   ClientLeft      =   1800
   ClientTop       =   1635
   ClientWidth     =   5700
   Height          =   5550
   Icon            =   SAMPLVBX.FRX:0000
   Left            =   1740
   LinkTopic       =   "Form1"
   ScaleHeight     =   4860
   ScaleWidth      =   5700
   Top             =   1005
   Width           =   5820
   Begin PictureBox Picture2
      Height          =   1245
      Left            =   3015
      ScaleHeight     =   1215
      ScaleWidth      =   2520
      TabIndex        =   5
      Top             =   3270
      Width           =   2550
   End
   Begin PictureBox Picture1
      Height          =   1245
      Left            =   165
      ScaleHeight     =   1215
      ScaleWidth      =   2520
      TabIndex        =   4
      Top             =   3285
      Width           =   2550
   End
   Begin Peacock Peacock1
      ColorName       =   "Black"
      ColorValue      =   0
      DefaultValue    =   0
      Left            =   1995
      Text            =   "Peacock1"
      Top             =   -180
   End
   Begin ListBox List2
      Height          =   2760
      Left            =   3030
      Sorted          =   -1  'True
      TabIndex        =   3
      Top             =   300
      Width           =   2520
   End
   Begin ListBox List1
      BackColor       =   &H00FFFFFF&
      Height          =   2760
      Left            =   165
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   295
      Width           =   2550
   End
   Begin CommonDialog CMDialog
      Left            =   4890
      Top             =   -270
   End
   Begin Label Label2
      Caption         =   "User Defined Colors"
      Height          =   255
      Left            =   2955
      TabIndex        =   2
      Top             =   45
      Width           =   2085
   End
   Begin Label Label1
      Caption         =   "Predefined Colors"
      Height          =   255
      Left            =   210
      TabIndex        =   1
      Top             =   45
      Width           =   2085
   End
   Begin Menu M_FILE
      Caption         =   "&File"
      Begin Menu M_EXIT
         Caption         =   "E&xit"
      End
   End
   Begin Menu M_EDIT
      Caption         =   "&Edit"
      Begin Menu M_ADD_COLOR
         Caption         =   "&Add Color"
      End
      Begin Menu M_CHANGE
         Caption         =   "&Change Color"
      End
      Begin Menu M_DELETE
         Caption         =   "&Delete Color"
      End
   End
   Begin Menu M_VIEW
      Caption         =   "&View"
      Begin Menu M_VIEW_COLOR
         Caption         =   "&Color Name"
         Begin Menu M_NAME_USER
            Caption         =   "&User Defined"
         End
         Begin Menu M_NAME_PRE
            Caption         =   "&Predefined"
         End
      End
      Begin Menu M_DETAIL
         Caption         =   "Color &Detail"
         Begin Menu M_COLOR_USER
            Caption         =   "&User Defined"
         End
         Begin Menu M_COLOR_PRE
            Caption         =   "&Predefined"
         End
      End
   End
End
Option Explicit

Sub Form_Load ()

  Dim i As Integer

  For i = 0 To peacock1.ColorListCnt - 1
    List1.AddItem peacock1.ColorList(i)
  Next

  For i = 0 To peacock1.UserColorListCnt - 1
    List2.AddItem peacock1.UserColorList(i)
  Next

  List1.ListIndex = 0
  List1_DblClick
  If peacock1.UserColorListCnt > 0 Then
    List2.ListIndex = 0
    List2_DblClick
  End If

End Sub

Sub List1_Click ()

  List1_DblClick

End Sub

Sub List1_DblClick ()

  Dim ColorName As String
  Dim Color As Long

  ColorName = List1.List(List1.ListIndex)

  peacock1.ColorName = List1.List(List1.ListIndex)
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color name " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  Picture1.BackColor = peacock1.ColorValue

End Sub

Sub List2_Click ()

  List2_DblClick

End Sub

Sub List2_DblClick ()

  Dim ColorName As String
  Dim Color As Long

  peacock1.ColorName = List2.List(List2.ListIndex)
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color name " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  Picture2.BackColor = peacock1.ColorValue

End Sub

Sub M_ADD_COLOR_Click ()

  Dim ColorName As String

  On Error GoTo ErrorHandler

  ColorName = InputBox("Enter New Color Name:", "Color Name")
  If ColorName = "" Then
    Exit Sub
  End If

  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_PREDEF_COLOR
  '
  ' if color exists in predef
  '
  If peacock1.Action = ACTION_NONE Then
    MsgBox "Error: Color " + ColorName + " already exists", 48, "Color Name Error"
    Exit Sub
  End If

  peacock1.Action = ACTION_GET_USER_COLOR
  If peacock1.Action = ACTION_NONE Then
    MsgBox "Error: User Color " + ColorName + " already exists", 48, "Color Name Error"
    Exit Sub
  End If

  CMDialog.CancelError = True
  CMDialog.Flags = &H2&
  CMDialog.Action = 3

  peacock1.ColorValue = CLng(CMDialog.Color)
  peacock1.Action = ACTION_ADD_COLOR
  List2.AddItem ColorName
  List2.ListIndex = List2.NewIndex
  Picture2.BackColor = CMDialog.Color

ErrorHandler:
  ' user pressed the cancel button
  Exit Sub

End Sub

Sub M_CHANGE_Click ()

  Dim ColorName As String
  Dim Color As Long
  Dim cnt As Integer

  On Error GoTo ErrorHandler2

  ColorName = InputBox("Enter Color Name To Change:", "Color Name", List2.List(List2.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If

  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_PREDEF_COLOR
  '
  ' if color exists in predef
  '
  If peacock1.Action = ACTION_NONE Then
    MsgBox "Error: " + ColorName + " is predefined - can only change user colors", 48, "Color Name Error"
    Exit Sub
  End If

  peacock1.Action = ACTION_GET_USER_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: User Color " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  peacock1.DefaultValue = CLng(CMDialog.Color)
  peacock1.Action = ACTION_GET_COLOR

  CMDialog.Color = peacock1.ColorValue
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3

  peacock1.ColorValue = CLng(CMDialog.Color)
  peacock1.Action = ACTION_ADD_COLOR

  Picture2.BackColor = CMDialog.Color

  '
  ' find colorName in the list and set the index to it
  '
  For cnt = 0 To List2.ListCount
    If List2.List(cnt) = ColorName Then
      List2.ListIndex = cnt
      Exit For
    End If
  Next

'
' Error handling here please
'
ErrorHandler2:
  ' user pressed the cancel button
  Exit Sub

End Sub

Sub M_COLOR_PRE_Click ()

  Dim ColorName As String
  Dim Color As Long

  On Error GoTo ErrorHandlerColorPre

  ColorName = InputBox("Enter Color Name To View:", "Color Name", List1.List(List1.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If

  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_COLOR
  '
  ' if color exists in predef
  '
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  peacock1.DefaultValue = Picture1.BackColor
  peacock1.Action = ACTION_GET_COLOR
  Picture1.BackColor = peacock1.ColorValue
  CMDialog.Color = peacock1.ColorValue
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3

ErrorHandlerColorPre:
  ' user pressed the cancel button
  Exit Sub


End Sub

Sub M_COLOR_USER_Click ()

  Dim ColorName As String
  Dim Color As Long

  On Error GoTo ErrorHandlerColorUser

  ColorName = InputBox("Enter Color Name To View:", "Color Name", List2.List(List2.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If

  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  peacock1.DefaultValue = Picture2.BackColor
  peacock1.Action = ACTION_GET_COLOR
  Picture2.BackColor = peacock1.ColorValue
  CMDialog.Color = peacock1.ColorValue
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3

ErrorHandlerColorUser:
  ' user pressed the cancel button
  Exit Sub

End Sub

Sub M_DELETE_Click ()

  Dim ColorName As String
  Dim Color As Long
  Dim cnt As Integer

  On Error GoTo ErrorHandlerDelete

  ColorName = InputBox("Enter Color Name To Delete:", "Color Name", List2.List(List2.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If

  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_PREDEF_COLOR
  If peacock1.Action = ACTION_NONE Then
    MsgBox "Error: " + ColorName + " is predefined - can only delete user colors", 48, "Color Name Error"
    Exit Sub
  End If

  peacock1.Action = ACTION_GET_USER_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: User Color " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  peacock1.Action = ACTION_DELETE_COLOR

  '
  ' find colorname in the user defined list and
  ' blow it away
  '
  For cnt = 0 To List2.ListCount
    If List2.List(cnt) = ColorName Then
      List2.RemoveItem cnt
      Exit For
    End If
  Next

  List2.ListIndex = 0
  List2_Click

'
' Error handling here please
'
ErrorHandlerDelete:
  ' user pressed the cancel button
  Exit Sub

End Sub

Sub M_EXIT_Click ()

  End

End Sub

Sub M_NAME_PRE_Click ()

  Dim ColorName As String
  Dim Color As Long

  ColorName = InputBox("Enter Color Name to View:", "View Color By Name", List1.List(List1.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If

  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color name " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  peacock1.DefaultValue = Picture1.BackColor
  peacock1.Action = ACTION_GET_COLOR
  Picture1.BackColor = peacock1.ColorValue

End Sub

Sub M_NAME_USER_Click ()

  Dim ColorName As String
  Dim Color As Long

  ColorName = InputBox("Enter Color Name to View:", "View Color By Name", List2.List(List2.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If

  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color name " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  peacock1.DefaultValue = Picture2.BackColor
  peacock1.Action = ACTION_GET_COLOR
  Picture2.BackColor = peacock1.ColorValue

End Sub